home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX" Object = "{FF8DA174-3574-11D4-8068-0060082AE372}#1.0#0"; "XCEEDFTP.DLL" Begin VB.Form frmMain BackColor = &H8000000B& Caption = "FTP Client sample application" ClientHeight = 7245 ClientLeft = 165 ClientTop = 450 ClientWidth = 12525 ClipControls = 0 'False Icon = "frmMain.frx":0000 LinkTopic = "Form1" MousePointer = 1 'Arrow ScaleHeight = 483 ScaleMode = 3 'Pixel ScaleWidth = 835 StartUpPosition = 2 'CenterScreen Begin ComctlLib.ProgressBar prgStatus Height = 195 Left = 6600 TabIndex = 24 Top = 7035 Width = 5640 _ExtentX = 9948 _ExtentY = 344 _Version = 327682 Appearance = 0 End Begin ComctlLib.StatusBar stbProgress Align = 2 'Align Bottom Height = 255 Left = 0 TabIndex = 25 Top = 6990 Width = 12525 _ExtentX = 22093 _ExtentY = 450 SimpleText = "" _Version = 327682 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 4 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} Object.Width = 7056 MinWidth = 7056 Key = "" Object.Tag = "" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Object.Width = 1764 MinWidth = 1764 Key = "" Object.Tag = "" EndProperty BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7} Object.Width = 2646 MinWidth = 2646 Key = "" Object.Tag = "" EndProperty BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7} AutoSize = 1 Object.Width = 10019 MinWidth = 176 Key = "" Object.Tag = "" EndProperty EndProperty End Begin VB.CommandButton cmdAbort Caption = "&Abort" Height = 375 Left = 5790 TabIndex = 3 ToolTipText = "Abort" Top = 1185 Width = 975 End Begin VB.CommandButton cmdRenameRemoteFile Caption = "Rename File" Height = 255 Left = 8340 TabIndex = 13 Top = 5400 Width = 1320 End Begin VB.OptionButton optBinary Caption = "Binary" Height = 255 Left = 5880 TabIndex = 23 Top = 4440 Width = 735 End Begin VB.OptionButton optAscii Caption = "ASCII" Height = 255 Left = 5880 TabIndex = 22 Top = 4680 Width = 735 End Begin VB.CommandButton cmdDeleteRemoteFile Caption = "Delete File" Height = 255 Left = 7020 TabIndex = 12 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdCreateRemoteFolder Caption = "Create Folder" Height = 255 Left = 9660 TabIndex = 14 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdDeleteRemoteFolder Caption = "Delete Folder" Height = 255 Left = 10980 TabIndex = 15 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdDeleteLocalFile Caption = "Delete File(s)" Height = 255 Left = 285 TabIndex = 6 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdRenameLocalFile Caption = "Rename File" Height = 255 Left = 1605 TabIndex = 7 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdCreateLocalFolder Caption = "Create Folder" Height = 255 Left = 2925 TabIndex = 8 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdRemoveLocalFolder Caption = "Delete Folder" Height = 255 Left = 4230 TabIndex = 9 Top = 5400 Width = 1320 End Begin VB.CommandButton cmdDisconnect Caption = "&Disconnect" Height = 375 Left = 5790 TabIndex = 2 ToolTipText = "Disconnect" Top = 720 Width = 975 End Begin VB.CommandButton cmdConnect Caption = "&Connect" Height = 375 Left = 5790 TabIndex = 1 ToolTipText = "Connect" Top = 240 Width = 975 End Begin VB.CommandButton cmdReceive Height = 375 Left = 5790 Picture = "frmMain.frx":030A Style = 1 'Graphical TabIndex = 5 Top = 3360 Width = 975 End Begin VB.Frame fraRemote Caption = "Remote Server" Height = 5655 Left = 6840 TabIndex = 20 Top = 120 Width = 5600 Begin VB.ComboBox cboRemotePath Height = 315 Left = 120 Sorted = -1 'True TabIndex = 16 Tag = "0" Top = 240 Width = 4815 End Begin VB.CommandButton cmdUpFtp Height = 315 Left = 4975 Picture = "frmMain.frx":074C Style = 1 'Graphical TabIndex = 17 Top = 240 Width = 495 End Begin ComctlLib.ListView lstRemoteFileList Height = 4575 Left = 120 TabIndex = 21 Top = 600 Width = 5385 _ExtentX = 9499 _ExtentY = 8070 SortKey = 3 View = 3 LabelEdit = 1 Sorted = -1 'True MultiSelect = -1 'True LabelWrap = -1 'True HideSelection = 0 'False OLEDragMode = 1 OLEDropMode = 1 _Version = 327682 Icons = "lstImageList" SmallIcons = "lstImageList" ForeColor = -2147483640 BackColor = -2147483643 BorderStyle = 1 Appearance = 1 OLEDragMode = 1 OLEDropMode = 1 NumItems = 4 BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Text = "Name" Object.Width = 3351 EndProperty BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} SubItemIndex = 1 Key = "" Object.Tag = "" Text = "Size (bytes)" Object.Width = 1940 EndProperty BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7} SubItemIndex = 2 Key = "" Object.Tag = "" Text = "Date" Object.Width = 3263 EndProperty BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7} SubItemIndex = 3 Key = "" Object.Tag = "" Text = "" Object.Width = 0 EndProperty End End Begin VB.Frame fraLocal Caption = "Local System" Height = 5655 Left = 120 TabIndex = 18 Top = 120 Width = 5600 Begin VB.ComboBox cboLocalPath Height = 315 ItemData = "frmMain.frx":0A8E Left = 120 List = "frmMain.frx":0A90 Sorted = -1 'True TabIndex = 10 Top = 240 Width = 4815 End Begin VB.CommandButton cmdUpLocal Height = 315 Left = 4980 Picture = "frmMain.frx":0A92 Style = 1 'Graphical TabIndex = 11 Top = 240 Width = 495 End Begin ComctlLib.ListView lstLocalFileList Height = 4575 Left = 120 TabIndex = 19 Top = 600 Width = 5385 _ExtentX = 9499 _ExtentY = 8070 SortKey = 3 View = 3 LabelEdit = 1 Sorted = -1 'True MultiSelect = -1 'True LabelWrap = -1 'True HideSelection = 0 'False OLEDragMode = 1 OLEDropMode = 1 _Version = 327682 Icons = "lstImageList" SmallIcons = "lstImageList" ForeColor = -2147483640 BackColor = -2147483643 BorderStyle = 1 Appearance = 1 OLEDragMode = 1 OLEDropMode = 1 NumItems = 4 BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} Key = "" Object.Tag = "" Text = "Name" Object.Width = 3351 EndProperty BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} SubItemIndex = 1 Key = "" Object.Tag = "" Text = "Size (bytes)" Object.Width = 1940 EndProperty BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7} SubItemIndex = 2 Key = "" Object.Tag = "" Text = "Date" Object.Width = 3263 EndProperty BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7} SubItemIndex = 3 Key = "" Object.Tag = "" Text = "" Object.Width = 0 EndProperty End End Begin VB.ListBox lstConnectionInfo Height = 1035 Left = 115 TabIndex = 0 TabStop = 0 'False Top = 5880 Width = 12315 End Begin VB.CommandButton cmdSend Height = 375 Left = 5790 Picture = "frmMain.frx":0DD4 Style = 1 'Graphical TabIndex = 4 Top = 2880 Width = 975 End Begin ComctlLib.ImageList lstImageList Left = 5760 Top = 2160 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 327682 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 3 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":1216 Key = "" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":1768 Key = "" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmMain.frx":1CBA Key = "" EndProperty EndProperty End Begin XceedFtpLibCtl.XceedFtp xFtp Left = 5760 Top = 1680 AccountName = "" AllocateStorage = 0 'False BackgroundProcessing= 0 'False CommandLogFilename= "" EventFilter = 8151 ListParsingFlags= 1 LocalDataAddress= "" LocalDataPort = 0 PassiveMode = -1 'True Password = "guest" RepresentationType= 0 ServerAddress = "" ServerPort = 21 UserName = "anonymous" FirewallType = 0 FirewallAddress = "" FirewallPort = 1080 FirewallUser = "" FirewallPassword= "" End Begin VB.Menu miConnection Caption = "Co&nnection" Begin VB.Menu miConnect Caption = "&Connect..." End Begin VB.Menu miDisconnect Caption = "&Disconnect" End Begin VB.Menu miAbort Caption = "&Abort" End End Begin VB.Menu miTransfer Caption = "&Transfer" Begin VB.Menu miSend Caption = "&Send File(s)" End Begin VB.Menu miReceive Caption = "&Receive File(s)" End End Begin VB.Menu miOperations Caption = "&Operations" Begin VB.Menu miLocal Caption = "&Local" Begin VB.Menu miDeleteLocalFile Caption = "Delete File(s)" End Begin VB.Menu miRenameLocalFile Caption = "Rename File" End Begin VB.Menu miCreateLocalFolder Caption = "Create Folder" End Begin VB.Menu miRemoveLocalFolder Caption = "Remove Folder" End End Begin VB.Menu miRemote Caption = "&Remote" Begin VB.Menu miDeleteRemoteFile Caption = "Delete File" End Begin VB.Menu miRenameRemoteFile Caption = "Rename File" End Begin VB.Menu miCreateRemoteFolder Caption = "Create Folder" End Begin VB.Menu miRemoveRemoteFolder Caption = "Remove Folder" End End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False ' Xceed FTP Library - FTP Client sample application ' Copyright (c) 2000 Xceed Software Inc. ' [FrmXceedFTP.frm] ' This form module contains code for the main form for the FTP client. ' This file is part of the Xceed FTP Library sample applications. The source ' code in this file is only intended as a supplement to Xceed FTP Library's ' documentation, and is provided "as is", without warranty of any kind, ' either expressed or implied. Option Explicit Dim WithEvents m_xLocalPaths As clsLocalPaths ' Handles local files (see clsLocalPaths module) Attribute m_xLocalPaths.VB_VarHelpID = -1 Dim m_xResizer As clsResizer ' Handles form resizing (see clsResizer module) ' Note: The xFtp object is instanciated automatically because there is an XceedFtp object ' named 'xFtp' that is placed on the main form. Dim m_sCurrentLocalPath As String ' Stores current local path Dim m_sCurrentRemotePath As String ' Stores current remote path Dim m_sLastServerAddressUsed As String ' Keep this information persistent Dim m_sLastServerPortUsed As String ' so that when the connection Dim m_sLastUsernameUsed As String ' dialog form is shown, user does Dim m_sLastPasswordUsed As String ' not have to retype everything Dim m_bIsAnonymous As Boolean ' each time. Const MsgBoxTitle = "FTP Client sample application " ' **************************************************************************** ' Look for character in reverse order. ' Equivalent to the VB6 InStrRev function. ' **************************************************************************** Private Function InStrReverse(ByVal sSource As String, ByVal sLookFor As String, ByVal nStart As Integer) As Integer Dim nLen As Integer nLen = Len(sSource) If nLen = 0 Then InStrReverse = 0 Else Dim sReverse As String sReverse = Space(nLen) Dim i As Integer For i = 1 To nLen Mid(sReverse, nLen - i + 1, 1) = Mid(sSource, i, 1) Next i InStrReverse = InStr(nLen - nStart + 1, sReverse, sLookFor) End If End Function ' **************************************************************************** ' Clear portions of the progress bar for single file operations. ' **************************************************************************** Private Sub ClearBars() prgStatus.Value = 0 stbProgress.Panels(2).Text = "" End Sub ' **************************************************************************** ' Delete file(s) from local system ' **************************************************************************** Private Sub DeleteSelectedLocalFile() Dim xItem As ListItem Dim nMsgResult As VbMsgBoxResult ' Confirm with the user first nMsgResult = MsgBox("Are you sure you want to delete the selected local file(s)?", _ vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then For Each xItem In lstLocalFileList.ListItems If xItem.Selected Then ' Delete the file(s) Call m_xLocalPaths.DeleteLocalFile(m_sCurrentLocalPath & xItem.Text) End If Next xItem Call RefreshLocalFileList End If End Sub ' **************************************************************************** ' Rename a file on the local system ' **************************************************************************** Private Sub RenameLocalFile() Dim sNewName As String Dim sCurrentName As String Dim nMsgResult As VbMsgBoxResult sCurrentName = m_sCurrentLocalPath & lstLocalFileList.SelectedItem.Text ' Confirm with the user first nMsgResult = MsgBox("Rename local file " & sCurrentName & "?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then sNewName = InputBox("Enter the new name for " & sCurrentName, "Xceed FTP Library - client sample") If sNewName <> "" Then ' Rename the file Call m_xLocalPaths.RenameLocalFile(sCurrentName, m_sCurrentLocalPath & sNewName) Call RefreshLocalFileList End If End If End Sub ' **************************************************************************** ' Create a new folder on the local system ' **************************************************************************** Private Sub CreateLocalFolder() Dim sFolderToCreate As String ' Query user for new folder's name sFolderToCreate = InputBox("Enter the name of the local folder you wish to create.", "Xceed FTP Library - client sample") If sFolderToCreate <> "" Then Call m_xLocalPaths.CreateLocalFolder(m_sCurrentLocalPath & sFolderToCreate) Call RefreshLocalFileList End If End Sub ' **************************************************************************** ' Delete a folder from the local system ' **************************************************************************** Private Sub DeleteLocalFolder() Dim nMsgResult As VbMsgBoxResult ' Confirm with the user first nMsgResult = MsgBox("Delete " & lstLocalFileList.SelectedItem.Text & "?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then 'Delete the local folder Call m_xLocalPaths.RemoveLocalFolder(m_sCurrentLocalPath & lstLocalFileList.SelectedItem.Text) Call RefreshLocalFileList Call UpdateLocalFilesState End If End Sub ' **************************************************************************** ' Delete file(s) from the remote system ' **************************************************************************** Private Sub DeleteSelectedRemoteFile() Dim nMsgResult As VbMsgBoxResult Dim xItem As ListItem ' Confirm with the user first nMsgResult = MsgBox("Are you sure you want to delete the selected remote file(s)?", _ vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then For Each xItem In lstRemoteFileList.ListItems ' For each item in the remote file list If xItem.Selected Then ' Delete selected file(s) only Call xFtp.DeleteFile(xItem.Text) stbProgress.Panels(1).Text = "" End If Next xItem Call RefreshRemoteFileList End If End Sub ' **************************************************************************** ' Rename a file on the remote server ' **************************************************************************** Private Sub RenameRemoteFile() Dim sNewName As String Dim nMsgResult As VbMsgBoxResult ' Confirm with the user first nMsgResult = MsgBox("Rename remote file " & lstRemoteFileList.SelectedItem.Text & "?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then ' Get new filename from user, then rename it sNewName = InputBox("Rename remote file to : ", "Xceed FTP Library - client sample") Call xFtp.RenameFile(lstRemoteFileList.SelectedItem.Text, sNewName) stbProgress.Panels(1).Text = "" Call RefreshRemoteFileList End If End Sub ' **************************************************************************** ' Create a new folder on the remote server ' **************************************************************************** Private Sub CreateRemoteFolder() Dim sFolderToCreate As String ' Query user for new folder's name sFolderToCreate = InputBox("Enter the name of the folder you want to create.", "Xceed FTP Library - client sample") Call xFtp.CreateFolder(sFolderToCreate) stbProgress.Panels(1).Text = "" Call RefreshRemoteFileList End Sub ' **************************************************************************** ' Delete a folder on the remote server ' **************************************************************************** Private Sub DeleteRemoteFolder() Dim nMsgResult As VbMsgBoxResult ' Confirm with the user first nMsgResult = MsgBox("Delete " & lstRemoteFileList.SelectedItem.Text & "?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then 'Delete the remote folder Call xFtp.RemoveFolder(lstRemoteFileList.SelectedItem.Text) stbProgress.Panels(1).Text = "" Call RefreshRemoteFileList End If End Sub ' **************************************************************************** ' The following procedure will open the connection dialog box so that ' the user can enter the information necessary in order to connect to an ' FTP server. ' **************************************************************************** Private Sub Connect() ' Show that the main form is no longer accepting commands Me.MousePointer = vbHourglass cboRemotePath.Tag = 1 ' Doing this will prevent the "click" event of the combo box from being triggered. ' Load the frmConnectionInfo dialog box Load frmConnectionInfo ' Call the connection dialog form's ShowForm function and check the ' result. If True, the user requested to Connect. False mans they cancelled out. If frmConnectionInfo.ShowForm(m_sLastServerAddressUsed, m_sLastServerPortUsed, m_sLastUsernameUsed, m_sLastPasswordUsed, m_bIsAnonymous) Then ' We don't need that connection form anymore Unload frmConnectionInfo ' Assign the variables which may have changed to the XceedFtp object's ' corresponding properties xFtp.ServerAddress = m_sLastServerAddressUsed xFtp.ServerPort = m_sLastServerPortUsed If m_bIsAnonymous Then xFtp.UserName = "anonymous" ' Common username for anonymous login xFtp.Password = "guest" ' Common password for anonymous login Else xFtp.UserName = m_sLastUsernameUsed xFtp.Password = m_sLastPasswordUsed End If ' Tell the XceedFtp object to connect to the remote FTP server. Call ConnectToFtpServer ' If connected, let's update some displayed data and enable the remote operation buttons If xFtp.CurrentState = fstConnected Then Call ListFilesOnServer ' List the files in the current remote folder Call UpdateConnectionState(True) ' Enable buttons End If Else ' User cancelled out from connection dialog form. We don't need that form anymore. Unload frmConnectionInfo End If ' Show that the main form is ready to accept commands again Me.MousePointer = vbDefault cboRemotePath.Tag = 0 End Sub ' **************************************************************************** ' This procedure tells the XceedFtp object to connect to the FTP server. The ' property values for the server address, port, username and password should ' allready be set before calling this procedure ' **************************************************************************** Private Sub ConnectToFtpServer() ' Connect only if not already connected! If xFtp.CurrentState = fstNotConnected Then On Error GoTo LocalError stbProgress.Panels(1).Text = "Connecting to " & xFtp.ServerAddress & ". Please wait..." Call xFtp.Connect ' Connect to the FTP server ' Get the current remote working folder m_sCurrentRemotePath = GetRemoteFolder ' Add the path to the remote paths combo box cboRemotePath.Text = m_sCurrentRemotePath ' Display connection success stbProgress.Panels(1).Text = "Connected to " & xFtp.ServerAddress Exit Sub End If LocalError: Call frmMain.DisplayMessage("Error: " & Err.Description) Call frmMain.UpdateAction("") End Sub ' **************************************************************************** ' This procedure calls the XceedFtp object's disconnect method to disconnect ' from the FTP server. Any currently running command will be aborted first. ' **************************************************************************** Private Sub Disconnect() ' If current state is other than connected or not connected, that means ' there is an operation currently running and we should abort it first. If (xFtp.CurrentState <> fstNotConnected) And (xFtp.CurrentState <> fstConnected) Then xFtp.Abort = True While (xFtp.CurrentState <> fstNotConnected) And (xFtp.CurrentState <> fstConnected) DoEvents Wend End If ' If we get here, there are no commands running. Disconnect only if connected. If xFtp.CurrentState <> fstNotConnected Then Call xFtp.Disconnect End If End Sub ' **************************************************************************** ' This procedure will send one or more of the currently selected files. ' For each selected item, this procedure checks to see if it is a folder or ' a file. If it is a folder, the entire folder's contents are sent by using ' the XceedFtp object's SendMultipleFiles method. If the selected item is ' a file, it is sent using the SendFile method. ' **************************************************************************** Private Sub SendFiles() Dim xItem As ListItem Dim nMsgResult As VbMsgBoxResult Dim sLocalPath As String On Error GoTo LocalError Me.MousePointer = vbHourglass ' Show that we are busy Call UpdateAbortButtonState(True) ' Allow abort button to be clicked For Each xItem In lstLocalFileList.ListItems If xItem.Selected Then ' Process only selected items Call ClearBars ' Clear the progress and the status bars sLocalPath = m_sCurrentLocalPath & xItem.Text ' Construct item's complete path If xItem.SmallIcon = 2 Then ' Selected item is a folder ' Folders are uploaded by using the * wildcard with the SendMultipleFiles ' method. We query the user to find out if the library should apply ' the * wildcard recursively or not. nMsgResult = MsgBox("Do you want to send any subfolders that are contained in the '" & sLocalPath & "' folder?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then ' Yes, send subfolders Call xFtp.SendMultipleFiles(sLocalPath & "\*", xFtp.CurrentFolder & "\" & xItem.Text, True, True) Else ' Do not send subfolders Call xFtp.SendMultipleFiles(sLocalPath & "\*", xFtp.CurrentFolder & "\" & xItem.Text, True, False) End If Else ' The selected item is a file 'Upload this item separately. If file exists, we'll append to it. Call xFtp.SendFile(sLocalPath, 0, xItem.Text, True) End If End If Next xItem Call UpdateAction("Upload complete") ' Display in the status bar that the process is complete Cleanup: Me.MousePointer = vbDefault Call UpdateAbortButtonState(False) Call RefreshRemoteFileList Exit Sub LocalError: Call DisplayMessage("Error: " & Err.Description) GoTo Cleanup End Sub ' **************************************************************************** ' This procedure will receive the selected files or folders from the FTP ' server. For folders, the procedure uses the XceedFtp object's ' ReceiveMultipleFiles method. For files, it uses the ReceiveFile method. ' **************************************************************************** Private Sub ReceiveFiles() Dim xItem As ListItem Dim nMsgResult As VbMsgBoxResult On Error GoTo LocalError Me.MousePointer = vbHourglass ' Show that we are busy Call UpdateAbortButtonState(True) ' Allow abort button to be clicked For Each xItem In lstRemoteFileList.ListItems If xItem.Selected Then ' Process only selected items Call ClearBars ' Clear the progress and status bars ' Add the remote folder name to the local destination If xItem.SmallIcon = 2 Then ' Selected item is a folder ' Receive the contents of the folder by using the * wildcard and the ' ReceiveMultipleFiles method. We query the user to find out if the ' library should apply the * wildcard recursively or not. nMsgResult = MsgBox("Do you want to receive any subfolders that are contained in the '" & xItem.Text & "' folder?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then ' Receive subfolders Call xFtp.ReceiveMultipleFiles(xItem.Text & "\*", m_sCurrentLocalPath, True) Else ' Do not receive subfolders Call xFtp.ReceiveMultipleFiles(xItem.Text & "\*", m_sCurrentLocalPath, False) End If Else ' Receive this item separately Call xFtp.ReceiveFile(xItem.Text, 0, m_sCurrentLocalPath & xItem.Text) End If End If Next xItem Call UpdateAction("Download complete") ' 'Update status panel to show that the process is complete Cleanup: Me.MousePointer = vbDefault Call UpdateAbortButtonState(False) Call RefreshLocalFileList Exit Sub LocalError: Call DisplayMessage("Error: " & Err.Description) GoTo Cleanup End Sub ' **************************************************************************** ' Clear the contents of the local file list ListView control. ' **************************************************************************** Private Sub ClearLocalFileList() Call lstLocalFileList.ListItems.Clear End Sub ' **************************************************************************** ' Clear the contents of the remote file list ListView control. ' **************************************************************************** Private Sub ClearRemoteFileList() Call lstRemoteFileList.ListItems.Clear End Sub ' **************************************************************************** ' This procedure verifies that a path does not already exist in the path list ' combo box. It returns True is the path exists, False if not. The second ' parameter of this procedure requires the combo box object to be searched. ' **************************************************************************** Private Function ComboPathExists(ByVal sPathToCheck As String, CB As ComboBox) As Boolean Dim nCount As Integer nCount = 0 ComboPathExists = False While nCount < CB.ListCount If UCase(sPathToCheck) = CB.List(nCount) Then ' The specified path exists! ComboPathExists = True nCount = CB.ListCount Else nCount = nCount + 1 End If Wend End Function ' **************************************************************************** ' Refresh the local file list ListView control and display the new contents by ' calling the RetreiveLocalFolderContents procedure in the clsLocalPaths class. ' **************************************************************************** Private Sub RefreshLocalFileList() Call ClearLocalFileList Call m_xLocalPaths.RetrieveLocalFolderContents(m_sCurrentLocalPath) End Sub ' **************************************************************************** ' Refresh the remote file list ListView control and display the new contents by ' calling the ListFilesOnServer procedure. This might take some time, so we ' set the mouse cursor to "wait" until the operation is completed. ' **************************************************************************** Private Sub RefreshRemoteFileList() ' Setup GUI for long operation Me.MousePointer = vbHourglass Call ClearRemoteFileList Call UpdateAbortButtonState(True) Call ListFilesOnServer ' Reset GUI back to normal Call UpdateAbortButtonState(False) stbProgress.Panels(1).Text = "" Me.MousePointer = vbDefault End Sub ' **************************************************************************** ' This function returns the number of selected items in a ListView. A ' reference to the ListView control must be passed by parameter. ' **************************************************************************** Private Function CountSelectedItems(LV As ListView) As Long Dim xItem As ListItem Dim nCount As Integer nCount = 0 For Each xItem In LV.ListItems If xItem.Selected Then nCount = nCount + 1 End If Next xItem CountSelectedItems = nCount End Function ' **************************************************************************** ' This procedure enables or disables some of the form's controls depending ' on the current connection state. The connection state is passed by parameter. ' **************************************************************************** Private Sub UpdateConnectionState(ByVal bConnected As Boolean) cmdDisconnect.Enabled = bConnected cmdUpFtp.Enabled = bConnected ' Some items need to be activated as soon as we are connected cmdCreateRemoteFolder.Enabled = bConnected miCreateRemoteFolder.Enabled = bConnected optAscii.Enabled = bConnected optBinary.Enabled = bConnected ' If we are not connected, we do not want to give the user the option to send files cmdSend.Enabled = bConnected miSend.Enabled = bConnected cboRemotePath.Enabled = bConnected miDisconnect.Enabled = bConnected miTransfer.Enabled = bConnected miRemote.Enabled = bConnected ' We want the connect button (and menu) to be disabled if we are connected cmdConnect.Enabled = Not bConnected miConnect.Enabled = Not bConnected End Sub ' **************************************************************************** ' This procedure updates the state of the abort button and the abort menu item. ' **************************************************************************** Private Sub UpdateAbortButtonState(ByVal bEnabled As Boolean) cmdAbort.Enabled = bEnabled miAbort.Enabled = bEnabled End Sub ' **************************************************************************** ' Update the state of the buttons and menus for remote file/folder operations. ' The button states depend largely on the number and type of items selected ' in the remote file list ListView object. ' **************************************************************************** Private Sub UpdateRemoteFilesState() Dim bMultipleSelected As Boolean Dim bFileListIsNothing As Boolean Dim nTypeOfItemSelected As Integer ' If nothing is selected, then all items will be disabled bFileListIsNothing = lstRemoteFileList.SelectedItem Is Nothing ' If something is selected, cound the amount of selected items, and check ' store their type (file, folder or link) in the nTypeOfItemsSelected variable If Not bFileListIsNothing Then bMultipleSelected = CountSelectedItems(lstRemoteFileList) > 1 If Not bMultipleSelected Then nTypeOfItemSelected = lstRemoteFileList.SelectedItem.SmallIcon Else nTypeOfItemSelected = 0 End If End If ' Now set the button states depending on the number and type of items selected cmdDeleteRemoteFile.Enabled = (Not bFileListIsNothing) And ((bMultipleSelected) Or (nTypeOfItemSelected = 1)) ' Many items, or one if it is a file miDeleteRemoteFile.Enabled = cmdDeleteRemoteFile.Enabled cmdRenameRemoteFile.Enabled = (Not bFileListIsNothing) And (nTypeOfItemSelected = 1) ' One item selected: its a file miRenameRemoteFile.Enabled = cmdRenameRemoteFile.Enabled cmdDeleteRemoteFolder.Enabled = (Not bFileListIsNothing) And (nTypeOfItemSelected = 2) ' One item selected: its a folder miRemoveRemoteFolder.Enabled = cmdDeleteRemoteFolder.Enabled cmdReceive.Enabled = (Not bFileListIsNothing) And (CountSelectedItems(lstRemoteFileList) > 0) ' One or more files selected miReceive.Enabled = cmdReceive.Enabled End Sub ' **************************************************************************** ' Update the state of the buttons and menus for local file/folder operations. ' The button states depend largely on the number and type of items selected ' in the remote file list ListView object. ' **************************************************************************** Private Sub UpdateLocalFilesState() Dim bMultipleSelected As Boolean Dim bFileListIsNothing As Boolean Dim nTypeOfItemSelected As Integer ' If nothing is selected, then all items will be disabled bFileListIsNothing = lstLocalFileList.SelectedItem Is Nothing ' if yes, everything is false ' If something is selected, cound the amount of selected items, and check ' store their type (file, folder or link) in the nTypeOfItemsSelected variable If Not bFileListIsNothing Then bMultipleSelected = CountSelectedItems(lstLocalFileList) > 1 If Not bMultipleSelected Then nTypeOfItemSelected = lstLocalFileList.SelectedItem.SmallIcon Else nTypeOfItemSelected = 0 End If End If ' Now set the button states depending on the number and type of items selected cmdDeleteLocalFile.Enabled = (Not bFileListIsNothing) And ((bMultipleSelected) Or (nTypeOfItemSelected = 1)) ' Many items, or one if it is a file miDeleteLocalFile.Enabled = cmdDeleteLocalFile.Enabled cmdRenameLocalFile.Enabled = (Not bFileListIsNothing) And (nTypeOfItemSelected = 1) ' One item selected: its a file miRenameLocalFile.Enabled = cmdRenameLocalFile.Enabled cmdCreateLocalFolder.Enabled = True ' At all times, connected or not! miCreateLocalFolder.Enabled = cmdCreateLocalFolder.Enabled cmdRemoveLocalFolder.Enabled = (Not bFileListIsNothing) And (nTypeOfItemSelected = 2) ' One item selected: its a folder miRemoveLocalFolder.Enabled = cmdRemoveLocalFolder.Enabled cmdSend.Enabled = (Not bFileListIsNothing) And (CountSelectedItems(lstLocalFileList) > 0) And (xFtp.CurrentState = fstConnected) ' One or more files selected miSend.Enabled = cmdSend.Enabled End Sub ' **************************************************************************** ' List the current remote folder's contents using the XceedFtp object's ' ListFolderContents method. The ListingFolderItem event will be triggered ' by the library in order to allow this sample application to obtain and ' display the items in our remote file list ListView control. ' **************************************************************************** Public Sub ListFilesOnServer() On Error GoTo LocalError ' We will let the Xceed FTP Library parse the FTP server's folder listing for us. xFtp.ListParsingFlags = flpAutomaticParsing Call UpdateAction("Obtaining directory listing...") ' Display note on status bar ' Start obtaining the folder listing (will trigger the ListingFolderItem event ' for each listed item) Call xFtp.ListFolderContents("") Exit Sub LocalError: Call DisplayMessage("Error: " & Err.Description) End Sub ' **************************************************************************** ' The following procedures are event handlers for button click events ' **************************************************************************** Private Sub cmdDeleteLocalFile_Click() Call DeleteSelectedLocalFile End Sub Private Sub cmdRenameLocalFile_Click() Call RenameLocalFile End Sub Private Sub cmdCreateLocalFolder_Click() Call CreateLocalFolder End Sub Private Sub cmdRemoveLocalFolder_Click() Call DeleteLocalFolder End Sub Private Sub cmdDeleteRemoteFile_Click() Call DeleteSelectedRemoteFile End Sub Private Sub cmdRenameRemoteFile_Click() Call RenameRemoteFile End Sub Private Sub cmdCreateRemoteFolder_Click() Call CreateRemoteFolder End Sub Private Sub cmdDeleteRemoteFolder_Click() Call DeleteRemoteFolder End Sub Private Sub cmdConnect_Click() Call Connect End Sub Private Sub cmdDisconnect_Click() Call Disconnect End Sub Private Sub cmdSend_Click() Call SendFiles End Sub Private Sub cmdReceive_Click() Call ReceiveFiles End Sub Private Sub cmdAbort_Click() Call Abort End Sub Private Sub miAbort_Click() Call Abort End Sub Private Sub miDeleteLocalFile_Click() Call DeleteSelectedLocalFile End Sub Private Sub miRenameLocalFile_Click() Call RenameLocalFile End Sub Private Sub miCreateLocalFolder_Click() Call CreateLocalFolder End Sub Private Sub miRemoveLocalFolder_Click() Call DeleteLocalFolder End Sub Private Sub miDeleteRemoteFile_Click() Call DeleteSelectedRemoteFile End Sub Private Sub miRenameRemoteFile_Click() Call RenameRemoteFile End Sub Private Sub miCreateRemoteFolder_Click() Call CreateRemoteFolder End Sub Private Sub miRemoveRemoteFolder_Click() Call DeleteRemoteFolder End Sub Private Sub miConnect_Click() Call Connect End Sub Private Sub miDisconnect_Click() Call Disconnect End Sub Private Sub miSend_Click() Call SendFiles End Sub Private Sub miReceive_Click() Call ReceiveFiles End Sub Private Sub optAscii_Click() xFtp.RepresentationType = frtASCII End Sub Private Sub optBinary_Click() xFtp.RepresentationType = frtBinary 'Binary (default) End Sub ' **************************************************************************** ' When a path is selected from the local paths combo box, this procedure is ' triggered to update the contents of the local file list ListView control ' **************************************************************************** Private Sub cboLocalPath_Click() Dim sPath As String sPath = cboLocalPath.List(cboLocalPath.ListIndex) Call ClearLocalFileList Call m_xLocalPaths.RetrieveLocalFolderContents(sPath) m_sCurrentLocalPath = sPath End Sub ' **************************************************************************** ' When a path is selected from the remote paths combo box, this procedure is ' triggered to update the contents of the remote file list ListView control ' **************************************************************************** Private Sub cboRemotePath_Click() Dim sPath As String sPath = cboRemotePath.List(cboRemotePath.ListIndex) If cboRemotePath.Tag = 0 Then 'We do not want the combo box's "click" event to be triggered Call ChangeCurrentRemoteFolder(sPath, True) Call ClearRemoteFileList Call UpdateAbortButtonState(True) Call ListFilesOnServer Call UpdateAbortButtonState(False) stbProgress.Panels(1).Text = "" End If m_sCurrentRemotePath = sPath End Sub ' **************************************************************************** ' Folder up button. Changes the current local folder to its parent folder and ' lists the contents of the parent folder. ' **************************************************************************** Private Sub cmdUpLocal_Click() Dim sNewCurrentLocalPath As String Dim i As Integer If Len(m_sCurrentLocalPath) > 3 Then 'only if the path is not the root i = InStrReverse(m_sCurrentLocalPath, "\", Len(m_sCurrentLocalPath) - 1) sNewCurrentLocalPath = Mid(m_sCurrentLocalPath, 1, i) Call ClearLocalFileList Call m_xLocalPaths.RetrieveLocalFolderContents(sNewCurrentLocalPath) m_sCurrentLocalPath = sNewCurrentLocalPath ' Change to the new current path ' Set the text of the local path selection combo box to the new current path cboLocalPath.Text = UCase(m_sCurrentLocalPath) Call UpdateLocalFilesState End If End Sub ' **************************************************************************** ' This function returns the current remote folder (the XceedFtp object's ' CurrentFoldre property is consulted) but also adds the path to the remote ' folder listing combo box. ' **************************************************************************** Public Function GetRemoteFolder() As String On Error GoTo LocalError GetRemoteFolder = xFtp.CurrentFolder ' We will send the new path information to our main form to add it to our combo box Call AddToRemotePaths(GetRemoteFolder) Exit Function LocalError: Call DisplayMessage("Error: " & Err.Description) End Function ' **************************************************************************** ' Change the current remote folder to the new one specifed by the user. ' **************************************************************************** Public Function ChangeCurrentRemoteFolder(ByVal sNewCurrentFolder As String, ByVal bShowErrors As Boolean) As Boolean On Error GoTo LocalError ChangeCurrentRemoteFolder = False Call xFtp.ChangeCurrentFolder(sNewCurrentFolder) ' Change the current remote folder ChangeCurrentRemoteFolder = True ' We successfully changed folders Call GetRemoteFolder ' Set the new current local folder Exit Function LocalError: If bShowErrors Then Call DisplayMessage("Error: " & Err.Description) End If End Function ' **************************************************************************** ' Abort the current operation (Sets the XceedFtp object's Abort property) ' **************************************************************************** Public Sub Abort() On Error Resume Next xFtp.Abort = True ' Abort the current operation If Err.Number <> 0 Then MsgBox "Cannot abort the current operation! Error: " & vbCrLf & Err.Description & Err.Number, vbOKCancel + vbExclamation, MsgBoxTitle & "[Notice]""" Err.Clear End If End Sub ' **************************************************************************** ' Changes the current remote folder to its parent folder and lists the contents ' of the parent folder ' **************************************************************************** Private Sub cmdUpFtp_Click() Call xFtp.ChangeToParentFolder m_sCurrentRemotePath = GetRemoteFolder Call ClearRemoteFileList Call UpdateAbortButtonState(True) Call ListFilesOnServer Call UpdateAbortButtonState(False) Call UpdateRemoteFilesState stbProgress.Panels(1).Text = "" ' Set the text of the remote combo box to the new current path cboRemotePath.Text = m_sCurrentRemotePath End Sub Private Sub Form_Load() Set m_xLocalPaths = New clsLocalPaths ' Create an instance of the clsLocalPaths class Set m_xResizer = New clsResizer ' Create an instance of the clsResizer class optBinary.Value = True ' Set default transfer type to Binary ' Add some suggestions by default for the connection dialog box m_sLastServerAddressUsed = "ftp.cdrom.com" m_sLastServerPortUsed = "21" m_sLastUsernameUsed = "" m_sLastPasswordUsed = "" m_bIsAnonymous = True ' Update the local and remote ListView object state (and the associated button states) Call UpdateLocalFilesState Call UpdateRemoteFilesState Call UpdateConnectionState(False) Call UpdateAbortButtonState(False) Call m_xLocalPaths.RetreiveLogicalDrives ' Get the logical drives m_sCurrentLocalPath = "C:\" ' Set the current local path ' Set the text of the local path selection combo box to the current path. cboLocalPath.Text = m_sCurrentLocalPath ' Retrieve the contents of the current local path and display them Call m_xLocalPaths.RetrieveLocalFolderContents(m_sCurrentLocalPath) Call m_xResizer.PrepareClass(Me) 'Prepare the clsResizer class End Sub ' **************************************************************************** ' If form is resized, tell our resizer class instance to do its job ' **************************************************************************** Private Sub Form_Resize() Call m_xResizer.ResizeControls ' Resize the controls End Sub ' **************************************************************************** ' Before form unloads, make sure we are disconnected and free any memory ' or classes we have allocated or instanciated ' **************************************************************************** Private Sub Form_Unload(Cancel As Integer) Call Disconnect ' Disconnect if currently connected Set m_xLocalPaths = Nothing ' Destroy our instance of the clsLocalPaths class Set m_xResizer = Nothing ' Destroy our instance of the clsResizer class End Sub ' **************************************************************************** ' Enable or disable the local file operation buttons depending on which items ' are selected in the local file list ListView control. ' **************************************************************************** Private Sub lstLocalFileList_Click() Call UpdateLocalFilesState End Sub ' **************************************************************************** ' Double clicking on a file in the local list has two possible results. If the ' selected item is a file, this procedure will send the file. If the selected ' item is a folder, this procedure will change the current local folder to the ' selected folder and then list its contents. ' **************************************************************************** Private Sub lstLocalFileList_DblClick() Dim nAttrib As Integer Dim sSelectedItem As String Dim nMsgResult As VbMsgBoxResult If lstLocalFileList.SelectedItem.SmallIcon = 1 Then ' Selected item is a file, send it! 'Make sure that we don't try sending a file if we aren't even connected! If xFtp.CurrentState <> fstNotConnected Then nMsgResult = MsgBox("Upload file '" & lstLocalFileList.SelectedItem.Text & "'?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") End If If nMsgResult = vbYes Then Call SendFiles End If Else ' Selected item is a folder, so we'll change our current folder to that sSelectedItem = m_sCurrentLocalPath & lstLocalFileList.SelectedItem.Text & "\" Call ClearLocalFileList Call m_xLocalPaths.RetrieveLocalFolderContents(sSelectedItem) ' List contents of a new folder Call UpdateLocalFilesState m_sCurrentLocalPath = sSelectedItem End If End Sub ' **************************************************************************** ' Enable or disable the local controls depending on the items selected in the ' remote file list ListView control. ' **************************************************************************** Private Sub lstRemoteFileList_Click() Call UpdateRemoteFilesState End Sub ' **************************************************************************** ' The items in the remote file list ListView control can be either files, ' folders or links. ' If the selected item is a file, then the ReceiveFiles procedure will be called. ' If it is a folder, then the current remote folder will be changed and the new ' contents will be listed. ' If the item is a link, then it can either link to a file or a folder. Since ' we do not have a way of determining beforehand if it is a file or a folder, ' we will first assume that it links to a folder and try to change the current ' remote folder. If this is successful, then we will list the contents of the ' new current remote folder. If this fails, we will consider the link to be ' a file and call the ReceiveFiles method. ' **************************************************************************** Private Sub lstRemoteFileList_DblClick() Dim sSelectedItem As String cboRemotePath.Tag = 1 ' Don't react to the click event anymore If xFtp.CurrentState = fstConnected Then ' Do something only if we are connected sSelectedItem = lstRemoteFileList.SelectedItem.Text Select Case lstRemoteFileList.SelectedItem.SmallIcon Case 1 ' Selected item is a file Call ReceiveFiles Case 2 'Selected item is a folder Call ChangeCurrentRemoteFolder(sSelectedItem, True) m_sCurrentRemotePath = GetRemoteFolder Call ClearRemoteFileList Call UpdateAbortButtonState(True) Call ListFilesOnServer Call UpdateAbortButtonState(False) Call UpdateRemoteFilesState stbProgress.Panels(1).Text = "" Case 3 ' Selected item is a link ' We will first try to change the current remote folder to see ' if the link is a link to a folder. If that fails then we will ' just download the file the link is pointing to. If ChangeCurrentRemoteFolder(sSelectedItem, False) Then ' Try changing the current remote folder m_sCurrentRemotePath = GetRemoteFolder Call ClearRemoteFileList Call UpdateAbortButtonState(True) Call ListFilesOnServer Call UpdateAbortButtonState(False) Call UpdateRemoteFilesState stbProgress.Panels(1).Text = "" Else ' Assume the link is a file and download it. Call ReceiveFiles End If End Select End If cboRemotePath.Tag = 0 ' Allow responding to the click event again End Sub ' **************************************************************************** ' If the right mouse button is clicked in the the local file list ListView ' control, we will pop up the local operations menu ' **************************************************************************** Private Sub lstLocalFileList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu miLocal End If End Sub ' **************************************************************************** ' If the right mouse button is clicked in the the remote file list ListView ' control, we will popup the remote operations menu. ' **************************************************************************** Private Sub lstRemoteFileList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu miRemote End If End Sub ' **************************************************************************** ' Drag and drop: Reactivate "dropping" in the local file list ListView control ' once the drag operation has completed. ' **************************************************************************** Private Sub lstLocalFileList_OLECompleteDrag(Effect As Long) lstLocalFileList.OLEDropMode = ccOLEDropManual End Sub ' **************************************************************************** ' Drag and drop: Call the ReceiveFiles method once the files are dropped in ' the local file list ListView control. ' **************************************************************************** Private Sub lstLocalFileList_OLEDragDrop(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) If Data.GetFormat(vbCFText) Then Call ReceiveFiles End If End Sub ' **************************************************************************** ' Drag and drop: Make sure that we are dragging text ' **************************************************************************** Private Sub lstLocalFileList_OLEDragOver(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) If Not Data.GetFormat(vbCFText) Then Effect = vbDropEffectNone End If End Sub ' **************************************************************************** ' Drag and drop: Make sure that we can't "drop" on the local file list ' ListView control when dragging from it. ' **************************************************************************** Private Sub lstLocalFileList_OLEStartDrag(Data As ComctlLib.DataObject, AllowedEffects As Long) lstLocalFileList.OLEDropMode = ccOLEDropNone End Sub ' **************************************************************************** ' Drag and drop: Reactivate "dropping" in the local file list ListView control ' nce the drag operation has completed. ' **************************************************************************** Private Sub lstRemoteFileList_OLECompleteDrag(Effect As Long) lstRemoteFileList.OLEDropMode = ccOLEDropManual End Sub ' **************************************************************************** ' Drag and drop: Call the SendFiles method once the files are dropped in the ' local file list ListView control. ' **************************************************************************** Private Sub lstRemoteFileList_OLEDragDrop(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) If Data.GetFormat(vbCFText) Then Call SendFiles End If End Sub ' **************************************************************************** ' Drag and drop: Make sure we are dragging text ' **************************************************************************** Private Sub lstRemoteFileList_OLEDragOver(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) If Not Data.GetFormat(vbCFText) Then Effect = vbDropEffectNone End If End Sub ' **************************************************************************** ' Drag and drop: Make sure we can't "drop" on the remote file list ListView ' control when dragging from it. ' **************************************************************************** Private Sub lstRemoteFileList_OLEStartDrag(Data As ComctlLib.DataObject, AllowedEffects As Long) lstRemoteFileList.OLEDropMode = ccOLEDropNone End Sub ' **************************************************************************** ' If an account is required, the AccountRequired event will be triggered by ' the XceedFtp object. This way, we have the opportunity to prompt the the ' user to enter account information and then give this info to the XceedFtp ' object in order for it to tell the FTP server about it. ' **************************************************************************** Private Sub xFtp_AccountRequired(sAccountName As String) Dim sNewAccountName As String sNewAccountName = InputBox("An account is required for this server.", MsgBoxTitle & "[Query]") sAccountName = sNewAccountName End Sub ' **************************************************************************** ' The XceedFtp object triggers the Disconnected event whenever the library ' disconnects or gets disconnected from the FTP server. We trap this event ' in order to update our form's interface to reflect this occurence. ' **************************************************************************** Private Sub xFtp_Disconnected() MsgBox "Disconnected from FTP server " & xFtp.ServerAddress, vbOKOnly, MsgBoxTitle & "[Notice]" cboRemotePath.Clear stbProgress.Panels(1).Text = "" stbProgress.Panels(3).Text = "" Call ClearRemoteFileList Call ClearBars Call UpdateConnectionState(False) Call UpdateRemoteFilesState End Sub ' **************************************************************************** ' The FileTransferStatus event provides us with a variety of information ' regarding the transfer status of each individual file and the information ' on the global progress of the current operation. ' **************************************************************************** Private Sub xFtp_FileTransferStatus(ByVal sLocalFilename As String, ByVal sRemoteFilename As String, ByVal lFileSize As Long, ByVal lBytesTransferred As Long, ByVal nBytesPercent As Integer, ByVal lTotalSize As Long, ByVal lTotalBytesTransferred As Long, ByVal nTotalBytesPercent As Integer, ByVal lTotalFiles As Long, ByVal lTotalFilesTransferred As Long, ByVal nTotalFilesPercent As Integer, ByVal lBytesPerSecond As Long, ByVal lTotalBytesPerSecond As Long) Call UpdateStatus(lBytesTransferred, lTotalBytesTransferred, nBytesPercent) End Sub ' **************************************************************************** ' The ListingFolderItem event is triggered for each item being listed as a ' result of a call to the XceedFtp object's ListFolderContents method. This ' event provides us with information on every file, folder or link. Our ' handler for the event (this procedure) adds the info to the remote folder ' list ListView object. ' **************************************************************************** Private Sub xFtp_ListingFolderItem(ByVal sName As String, ByVal dtDate As Date, ByVal lFileSize As Long, ByVal eItemType As XceedFtpLibCtl.EXFFolderItemType, ByVal sUserData As String) Dim xItem As ListItem Select Case eItemType Case fitFolder ' Item being listed is a folder Set xItem = lstRemoteFileList.ListItems.Add(, , sName, , 2) xItem.SubItems(1) = lFileSize xItem.SubItems(2) = dtDate xItem.SubItems(3) = "D" ' This column is used only for sorting by item type Case fitFile ' Item being listed is a file Set xItem = lstRemoteFileList.ListItems.Add(, , sName, , 1) xItem.SubItems(1) = lFileSize xItem.SubItems(2) = dtDate xItem.SubItems(3) = "F" ' This column is used only for sorting by item type Case fitLink ' Item being listed is a link Set xItem = lstRemoteFileList.ListItems.Add(, , sName, , 3) xItem.SubItems(1) = lFileSize xItem.SubItems(2) = dtDate xItem.SubItems(3) = "E" ' To sort in between D and F above! End Select End Sub ' **************************************************************************** ' The LoggingCommandLine event is triggered by the XceedFtp object for every ' command sent and received to/from the FTP server. Instead of writing our own ' custom messages for every possible action in order to display progress on ' our status bar, we will be using the information provided by XceedFtp. ' **************************************************************************** Private Sub xFtp_LoggingCommandLine(ByVal sLine As String, ByVal eCommandType As XceedFtpLibCtl.EXFCommandType) Call DisplayMessage(sLine) End Sub ' **************************************************************************** ' If a password is required or if an invalid password was provided, the ' PasswordRequired event will be triggered by the XceedFtp object. We then ' have the chance to query the user for a password and provide it back to ' the XceedFtp object to try again! ' **************************************************************************** Private Sub xFtp_PasswordRequired(sPassword As String) Dim sNewPassword As String sNewPassword = InputBox("Please enter the correct password", MsgBoxTitle & "[Query]") sPassword = sNewPassword 'Set the new password End Sub ' **************************************************************************** ' The ReceivingFile event is triggered for every file that is about to be ' received and provides our FTP Client with information regarding that ' file. It also gives us the option to change the path and filename of ' the file we are receiving. ' **************************************************************************** Private Sub xFtp_ReceivingFile(ByVal sRemoteFilename As String, sLocalFilename As String, ByVal lFileSize As Long) Call UpdateAction("Receiving " & sRemoteFilename) End Sub ' **************************************************************************** ' If the file being received or sent exists, the ReplacingFile event gives ' our sample application the option of overwriting, skipping it, etc... ' **************************************************************************** Private Sub xFtp_ReplacingFile(sFilename As String, ByVal dtDate As Date, ByVal lFileSize As Long, ByVal sRemoteFilename As String, eAction As XceedFtpLibCtl.EXFReplaceAction) Dim nMsgResult As VbMsgBoxResult ' Ask user if they want to replace the existing file. nMsgResult = MsgBox(sFilename & " already exits. Do you want to replace it?", vbYesNo + vbQuestion, MsgBoxTitle & "[Confirm]") If nMsgResult = vbYes Then eAction = fraOverwrite 'Replace the file Else eAction = fraSkip 'Skip the file End If End Sub ' **************************************************************************** ' The SendFile event is triggered for every file that is about to be sent and ' provides us with information regaring that file, It also gives us the option ' to change the filename of the file we are sending. ' **************************************************************************** Private Sub xFtp_SendingFile(ByVal sLocalFilename As String, sRemoteFilename As String, ByVal lFileSize As Long) Call UpdateAction("Sending " & sLocalFilename) End Sub ' **************************************************************************** ' For every file that is skipped, wether sending or receiveing, the ' XceedFtp object will trigger the SkippingFile event. We then know which ' file is being skipped and for what reason. We can then display a message ' to the user. ' **************************************************************************** Private Sub xFtp_SkippingFile(ByVal sLocalFilename As String, ByVal sRemoteFilename As String, ByVal eSkippingReason As XceedFtpLibCtl.EXFError) Dim ReasonString As String If sLocalFilename = "" Then Call DisplayMessage(CStr(sRemoteFilename & " was skipped. Reason:" & xFtp.GetResultDescription(eSkippingReason))) End If If sRemoteFilename = "" Then Call DisplayMessage(CStr(sLocalFilename & " was skipped. Reason:" & xFtp.GetResultDescription(eSkippingReason))) End If End Sub ' **************************************************************************** ' Add a new path to the remote combo box ' **************************************************************************** Public Sub AddToRemotePaths(ByVal sPathToAdd As String) ' Check if the path already exists If Not ComboPathExists(sPathToAdd, cboRemotePath) Then ' If it does not exist, then add it Call cboRemotePath.AddItem(sPathToAdd) cboRemotePath.ListIndex = cboRemotePath.NewIndex Else cboRemotePath.Text = sPathToAdd End If End Sub ' **************************************************************************** ' Update the status bar panels while sending and receiving ' **************************************************************************** Public Sub UpdateStatus(ByVal lBytes As Long, ByVal lTotalBytes As Long, ByVal nBytesPercent As Integer) stbProgress.Panels(2).Text = CStr(lBytes) stbProgress.Panels(3).Text = "Total : " & CStr(lTotalBytes) prgStatus.Value = nBytesPercent End Sub ' **************************************************************************** ' Update the first panel of the status bar to display the name of the file ' being sent or received as well as notify the user when the operation is ' complete ' **************************************************************************** Public Sub UpdateAction(ByVal sMessage As String) stbProgress.Panels(1).Text = sMessage End Sub ' **************************************************************************** ' Add a new path to the local path selection combo box ' **************************************************************************** Private Sub m_xLocalPaths_AddToLocalPaths(ByVal sPathToAdd As String) ' Check first to see if the path exists If Not ComboPathExists(sPathToAdd, cboLocalPath) Then Call cboLocalPath.AddItem(UCase(sPathToAdd)) ' If it does not exist, we add it cboLocalPath.ListIndex = cboLocalPath.NewIndex Else cboLocalPath.Text = sPathToAdd End If End Sub ' **************************************************************************** ' Display a message on the form ' **************************************************************************** Public Sub DisplayMessage(ByVal sMessage As String) lstConnectionInfo.AddItem (sMessage) lstConnectionInfo.ListIndex = lstConnectionInfo.ListCount - 1 End Sub ' **************************************************************************** ' Add a new entry to the local file list ListView control. We will also set ' the appropriate icon depending on if the item is a file a folder. ' **************************************************************************** Private Sub m_xLocalPaths_UpdateLocalEntry(ByVal sName As String, ByVal dtDate As Date, ByVal lSize As Long, ByVal nAttrib As Integer) Dim xItem As ListItem If nAttrib = -1 Then ' Unknown item type Set xItem = lstLocalFileList.ListItems.Add(, , sName, , 1) ' If there was a problem xItem.SubItems(1) = lSize xItem.SubItems(2) = dtDate xItem.SubItems(3) = "F" ' For sorting by item type ElseIf nAttrib And vbDirectory Then Set xItem = lstLocalFileList.ListItems.Add(, , UCase(sName), , 2) ' If it was a folder xItem.SubItems(1) = "" xItem.SubItems(2) = dtDate xItem.SubItems(3) = "D" ' For sorting by item type Else 'Is a file Set xItem = lstLocalFileList.ListItems.Add(, , sName, , 1) ' If it was a file xItem.SubItems(1) = lSize xItem.SubItems(2) = dtDate xItem.SubItems(3) = "F" ' For sorting by item type End If End Sub ' **************************************************************************** ' Add the logical system drive to the local path selection combo box ' **************************************************************************** Private Sub m_xLocalPaths_LogicalDriveFound(ByVal sDriveToAdd As String) cboLocalPath.AddItem (UCase(sDriveToAdd)) End Sub 
(.txt)